unit uIEParser;

interface

uses
  SysUtils, Classes, IEParser, IEConst, Windows, MSHTML_EWB, Forms;

const
  READ_TIMEOUT = 5000;

type
  TIEReadTimeOut = class;
  TIEParserEx = class(TIEParser)
  private
    FTimeOut: Integer;
    FIEReadTimeOut: TIEReadTimeOut;
    FOnParseCompleteEx: TOnParseCompleteEvent;
    procedure OnReadTimeOut(Sender: TObject);
    procedure DesposeTimeThread;
    procedure StartParsing(Sender: TObject; const aUrl: WideString);
    procedure ParseComplete(Sender: TObject; Doc: IhtmlDocument2; All: IHtmlElementCollection);
    procedure SetOnParseCompleteEx(const Value: TOnParseCompleteEvent);
//    procedure ParseError(Sender: TObject; const ErrorCode: integer;
//      const Url, stError: string);
  public
    constructor Create(Owner: Tcomponent); override;
    destructor Destroy; override;

    property TimeOut: Integer read FTimeOut write FTimeOut;
    property OnParseCompleteEx: TOnParseCompleteEvent read FOnParseCompleteEx write SetOnParseCompleteEx;
  end;

  TIEReadTimeOut = class(TThread)
  private
    FTimeOut: Integer;
    FExitFlag: Boolean;
    FAfterTimeOut: TNotifyEvent;
  protected
    procedure Execute; override;
  public
    constructor Create(ATimeOut: Integer; AfterTimeOut: TNotifyEvent);
    property ExitFlag: Boolean read FExitFlag write FExitFlag;
  end;

  TIEParserThread = class(TThread)
  private
    FUrl: WideString;
    FIEParserEx: TIEParserEx;
    procedure Go;
  protected
    procedure Execute; override;
  public
    procedure Parse(AUrl: WideString; const TimeOut: Integer = READ_TIMEOUT;
      const AParseComplete: TOnParseCompleteEvent = nil);

    constructor Create;
    destructor Destroy; override;
  end;

implementation

{ TIEReadTimeOut }

constructor TIEReadTimeOut.Create(ATimeOut: Integer; AfterTimeOut: TNotifyEvent);
begin
  FreeOnTerminate := False;
  FTimeOut := ATimeOut;
  FAfterTimeOut := AfterTimeOut;
  FExitFlag := False;

  inherited Create(False);
end;

procedure TIEReadTimeOut.Execute;
var
  t0, t1: Integer;
begin
  try
    t0 := GetTickCount;
    while not FExitFlag do
    begin
      t1 := GetTickCount;
      if t1-t0>=FTimeOut then
      begin
        if Assigned(FAfterTimeOut) then
        begin
          FAfterTimeOut(nil);
        end;
        FExitFlag := True;
      end;
      Sleep(100);
    end;
  finally
    Terminate;
  end;
end;

{ TIEParserEx }

constructor TIEParserEx.Create(Owner: Tcomponent);
begin
  inherited Create(Owner);
  DownloadOptions := [DontExecuteScripts, DontExecuteJava, DontExecuteActiveX,
    DontDownloadActiveX, DontDownloadBehaviors];
  FTimeOut := READ_TIMEOUT;
//  OnStartParsing := StartParsing;
//  OnParseComplete := ParseComplete;
//  OnParseError := ParseError;
end;

destructor TIEParserEx.Destroy;
begin
  DesposeTimeThread;
//  if ParserState=psBusy then
//    Stop;
  inherited;
end;

procedure TIEParserEx.DesposeTimeThread;
begin
  if Assigned(FIEReadTimeOut) then
  begin
    FIEReadTimeOut.ExitFlag := True;
//    FIEReadTimeOut.Suspend;
    TerminateThread(FIEReadTimeOut.Handle, 0);
    FreeAndNil(FIEReadTimeOut);
  end;
end;

procedure TIEParserEx.OnReadTimeOut(Sender: TObject);
begin
//  if ParserState=psBusy then
//    Stop;
end;

procedure TIEParserEx.ParseComplete(Sender: TObject; Doc: IhtmlDocument2;
  All: IHtmlElementCollection);
begin
  DesposeTimeThread;
  if Assigned(FOnParseCompleteEx) then
    FOnParseCompleteEx(Sender, Doc, All);
end;

//procedure TIEParserEx.ParseError(Sender: TObject; const ErrorCode: integer;
//  const Url, stError: string);
//begin
//
//end;

procedure TIEParserEx.SetOnParseCompleteEx(const Value: TOnParseCompleteEvent);
begin
  FOnParseCompleteEx := Value;
end;

procedure TIEParserEx.StartParsing(Sender: TObject;
  const aUrl: WideString);
begin
  DesposeTimeThread;
  FIEReadTimeOut := TIEReadTimeOut.Create(FTimeOut, OnReadTimeOut);
end;

{ TIEParserThread }

constructor TIEParserThread.Create;
begin
  inherited Create(True);
  FIEParserEx := TIEParserEx.Create(nil);
  FreeOnTerminate := True;
end;

destructor TIEParserThread.Destroy;
begin
  FreeAndNil(FIEParserEx);
  inherited;
end;

procedure TIEParserThread.Execute;
begin
  try
    Go;
  finally
    Terminate;
  end;
end;

procedure TIEParserThread.Go;
begin
  try
    FIEParserEx.Parse(FUrl);
  except
    on E: Exception do
    begin
      FIEParserEx.OnParseCompleteEx(nil, nil, nil);
    end;
  end;
end;

procedure TIEParserThread.Parse(AUrl: WideString;
  const TimeOut: Integer; const AParseComplete: TOnParseCompleteEvent);
begin
  FUrl := AUrl;
  FIEParserEx.TimeOut := TimeOut;
  if Assigned(AParseComplete) then
    FIEParserEx.OnParseCompleteEx := AParseComplete;
  Resume;
end;

end.
